perm filename NEWMRK.F4[NEW,LCS]1 blob sn#509265 filedate 1980-05-09 generic text, type T, neo UTF8
C************ READX, NEWMRK, DOIT, MORMRK, DASHES, CPYALL  **************

	SUBROUTINE READX
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /ALF/INP(72)/SCM/V(78)
	EQUIVALENCE (V(2),V2)
C****320	REREAD 2430,J,R2,RJQ
C  ↑↑↑ 1/78
	DO 2 K=2,72
	IF(INP(K).NE.'<')GO TO 2
	DO 3 J=K,72
3	INP(J)=' '
	GO TO 4
2	CONTINUE
C CATCH '<' -- WHICH = COMMENT FOR REST OF LINE
4	CALL RREAD(INP,V)
	JA=V(1)
	R2=V2
	DO 1 K=1,20
1	RJQ(K)=V(K+2)
	END

	SUBROUTINE NEWMRK(VX)
	DIMENSION VX(1)
	COMMON /DPY/ST(3690),N(1),N2,N3,JN(72),KN(172),RX(50),JJ,NN,MM
	1 /SC/A,B,C,D,E,NNN /ALF/INP(1) /MX/MX,MZ
	MX=0
C MX IS FLAG FOR LINE TOO LONG IN NEW FORMAT
	J=0
	MM=0
10	JJ=0
	NN=0
	N2=0
1	J=J+1
	IF(J.GT.72)GO TO 20
C JUMP IF DONE
	M=INP(J)
CURRENT CHARACTER
	IF(M.EQ.'-')GO TO 21
C  '-' NEEDED FOR "C-" (DECRESC. SIGN)
	IF(M.LT.'A'.OR.M.GT.'Z')GO TO 2
C JUMP IF A LETTER IS NOT FOUND
21	JJ=JJ+1
	N(JJ)=M
	GO TO 1
2	IF(M.EQ.' ')GO TO 1
5	NN=NN+1
	JN(NN)=M
C SAVE THE NUMBER CHARS.
6	J=J+1
	M=INP(J)
	IF(M.GE.'0'.AND.M.LE.'9')GO TO 5
	IF(M.EQ.'.')GO TO 5
	IF(M.NE.':')GO TO 22
	M='-'
C NEG. N2 WILL =TOTAL OF ITEMS STARTING WITH N1( /S 12:3/=/S 12-14/)
	NN=NN+1
	JN(NN)=' '
	GO TO 5
22	IF(M.EQ.' ')GO TO 6
	IF(M.NE.'-')GO TO 7
C NOW A SEQUENCE OF ITEMS
	M=' '
	GO TO 5
7	IF(M.NE.',')GO TO 8
C NOW A SINGLE ITEM
	CALL DOIT
	NN=0
C ITEM OR ITEMS NOW FINISHED
	GO TO 6
8	IF(M.NE.'/')GO TO 11
	CALL DOIT
	GO TO 10
11	IF(M.NE.';'.AND.M.NE.'*')GO TO 6
C JUMP IF UNKNOWN CHAR.
	CALL DOIT
	KN(MM)=M
	IF(MM.LE.71)GO TO 20
C SKIP IF REVISED LINE NOT TOO LONG
	MZ=MM
	DO 201 MM=71,1,-1
201	IF(KN(MM).EQ.'/')GO TO 202
202	MX=MM+1
C POINTS TO START OF REMAINDER OF TOO-LONG LINE
	INP(72)=0
CC20	DO 12 K=1,MM
CC12	INP(K)=KN(K)
CC	DO 13 K=MM+1,J
CC13	INP(K)=' '
CCC NOW GO FIX UP THE VX ARRAY.
CC	CALL RREAD(INP,VX)
CC	DO 23 K=1,50
CC	X=VX(K)
CC	IF(X.GT.0)Z=X
CCC SAVE THE LAST POSITIVE NUM.
CC	IF(X.LT.0)VX(K)=-X+Z-1.
CCC /S 17:5/=/S 17-21/ I.E. 5 NOTES STACCATO, STARTING WITH 17
CC23	CONTINUE
CC999	NNN=VX(1)
20	CALL MORMRK(1,MM,VX)
	END

	SUBROUTINE DOIT
	COMMON /DPY/ST(3690),N(1),N2,N3,JN(72),KN(172),RX(50),JJ,NN,MM
	IF(N(1).NE.'C'.AND.N(1).NE.'O')GO TO 3
CATCHES /C 5-7/C- 11.2-13.5/O 1-21/  ETC.
	IF(N2.EQ.'R')GO TO 3
C JUMP IF "CR"  FOR WORD "CRESC."
	DO 4 K=1,NN
	MM=MM+1
	JX=JN(K)
	KN(MM)=JX
4	IF(JX.EQ.' ')GO TO 5
C  FIRST NUMBER COMPLETED
5	DO 6 JX=1,JJ
	MM=MM+1
6	KN(MM)=N(JX)
CODE LETTER INSERTED
	MM=MM+1
	KN(MM)=' '
	DO 7 JX=K+1,NN
C NOW PUT IN LAST NUMBER
	MM=MM+1
7	KN(MM)=JN(JX)
	GO TO 8
3	DO 1 K=1,NN
	MM=MM+1
1	KN(MM)=JN(K)
	MM=MM+1
	KN(MM)=' '
	DO 2 K=1,JJ
	MM=MM+1
2	KN(MM)=N(K)
C NOW PUT IN THE CODE WORD
8	MM=MM+1
	KN(MM)='/'
CLOSE OFF THE ITEM
	END

CC	SUBROUTINE MORMRK(VX)
	SUBROUTINE MORMRK(MA,MB,VX)
	DIMENSION VX(1)
	COMMON /DPY/ST(3690),N(1),N2,N3,JN(72),KN(172),RX(50),JO,NN,MM
	1 /SC/A,B,C,D,E,NNN /ALF/INP(1) /MX/MX,MZ
CC	K=0
	MM=0
C GET THE REST OF A TOO-LONG LINE
	DO 1 K=MA,MB
CC	DO 1 J=MX,MZ
	MM=MM+1
CC	K=K+1
1	INP(MM)=KN(K)
CC1	INP(K)=KN(J)
CC	MM=K
	DO 13 K=MM+1,72
13	INP(K)=' '
	IF(INP(MM).EQ.'*')INP(72)='*'
C LINE ENDS WITH * OR ;
C NOW GO FIX UP THE VX ARRAY.
3	CALL RREAD(INP,VX)
	DO 23 K=1,50
	X=VX(K)
	IF(X.GT.0)Z=X
C SAVE THE LAST POSITIVE NUM.
	IF(X.LT.0)VX(K)=-X+Z-1.
C /S 17:5/=/S 17-21/ I.E. 5 NOTES STACCATO, STARTING WITH 17
23	CONTINUE
999	NNN=VX(1)
CC	MX=0
	END
 
	SUBROUTINE DASHES(IX,R2,R3,R4,R5,R6)
      COMMON /XRN/RN(3000)/PTR/KWDS(350)/DL/K22 /STF/RSTFAC(0/7),RSTJ2
C FIND CLOSEST WORD TO LFT AND RIGHT OF R3
	B=9999.0
	A=-B
	LFT=0
	DO 1 K=1,IX
C GETS CODE NUM. J=PTR TO THAT ITEM.
	J=KWDS(K)
5	IF(RN(J+1).NE.16)GO TO 1
C FOUND WORD
	IF(RN(J+2).NE.R2)GO TO 1
C NOW ON THIS STAFF
7	RR3=RN(J+3)
	IF(RR3.GT.R3)GO TO 3
	IF(RR3.LE.A)GO TO 1
	A=RR3
	LFT=J
C A WILL BE POS. OF FRONT OF LEFT GROUP.  LFT IS PNTR.
	GO TO 1
3	IF(RR3.GE.B)GO TO 1
	B=RR3
	JRT=J
1	CONTINUE
C WON'T WORK WITH OVERLAPPING WORDS!!!!

	J=LFT
	IF(LFT.EQ.0)J=JRT
2	R5=RN(J+5)*RSTJ2
CC2	R=RN(LFT+5)*RSTJ2  
C R=REAL SIZE FACTOR FOR SPACE     RN(LFT+9) IS WIDTH OF GROUP TO LEFT.
	R3=R5*(RN(J+9)-0.5)+A
	R6=B-R5*3.32
	IF(R3.LT.0)R3=1.
	IF(R6.GT.201)R6=201.
C 3.32 IS BASIC WIDTH OF MOST LETTERS
4	R4=RN(J+4)+1.0-R5*0.5
CC4	R4=RN(LFT+4)+1.0-RN(LFT+5)*0.5*RSTJ2
C  SET HEIGHT OF DASH   CONSIDERS LETTER SIZE AND STAFF SIZE
	R5=R4
	END

	SUBROUTINE CPYALL
C COPIES ALL OF ONE CODE NUM. FROM ONE STAFF TO ALL OTHER ACTIVE STAVES.
	COMMON  /LIMIT/LIMIT,ITEM,L,I /PTR/KWDS(1) /POSI/S(8),JJ2
	COMMON R2,J,K,N,RJQ(3),R6,RJ(16),NO,JQ(10),NN,LL  /XRN/RN(1) 
	JJ2=ITEM+1
	J=ITEM
C NOW FIND WHICH STAVES CURRENTLY ACTIVE
	DO 1 K=0,7
1	JQ(K)=0
	DO 2 K=1,J
	L=KWDS(K)
2	JQ(IFIX(RN(L+2)))=-1
	JQ(IFIX(R2))=0
C BUT OMIT SOURCE STAFF
	DO 3 K=1,J
	L=KWDS(K)
	IF(RTLINE(L).LT.0)GO TO 3
C ON RIGHT LINE?
	IF(OUTLIM(L,3).LT.0)GO TO 3
C  WITHIN GIVEN LFT AND RT LIMITS?
9	IF(RN(L+1).NE.R6)GO TO 3
C FOUND A SOURCE ITEM (CODE# IN R11).  NOW PUT IT ON ALL OTHER STAVES.
7	NN=RN(L)+3
C NUMBER OF NEW WORDS ADDED TO ARRAY
	DO 8 N=0,7
	IF(JQ(N).EQ.0)GO TO 8
4	CALL LOOP(0,NN,1,I,L,RN)
5	ITEM=ITEM+1
	LL=KWDS(ITEM)
	RN(LL+2)=N
C PUT IN CORRECT STAFF NUM.
6	I=I+NN
C UPDATE XRN ARRAY COUNTER AND POINTER ARRAY.
	KWDS(ITEM+1)=I
8	CONTINUE
3	CONTINUE
CC	JJ2=ITEM+1
	END